home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
BTV115.ARJ
/
BTV.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-06-02
|
114KB
|
2,777 lines
{*
* ┌───────────────────────────────────────────────────────────────┐
* │ BTV.PAS Version 1.15 │
* │ │
* │ BTRIEVE object oriented interface for Turbo Pascal 6.0. │
* │ │
* │ Copyright (c) 1992 by Richard W. Hansen, all rights reserved. │
* └───────────────────────────────────────────────────────────────┘
*
*
* Requires Turbo Pascal version 6.0
*
*
* Registration and payment of a license fee is required for any use, whether
* in whole or part, of this source code.
*
*}
{****************************************************************************}
{* REVISION HISTORY *}
{* *}
{* Date Who What *}
{* ======================================================================== *}
{* 02/01/92 RWH Changed DataSize, BytesRead, BytesToWrite from Integer to *}
{* Word so variable length records can be up to 64K. *}
{* 02/04/92 RWH Check that memory allocation size > 0 before issuing an *}
{* out of memory error. *}
{* Added ErrorHandler calls for out of memory errors. *}
{* 02/08/92 RWH Added error setting routines to the file object, so calls *}
{* through the error handler object pointer are not needed. *}
{* 02/20/92 RWH Fixed bug in Clone. Wrong file name being used caused *}
{* lockup. *}
{* 02/28/92 RWH Added Recover, Save and Load methods. *}
{* 03/14/92 RWH Open was not calculating the largest key correctly. *}
{* 04/25/92 RWH Added the FillKeyBuffer method. *}
{* 05/13/92 RWH Fixed problem with KeyStart buffer not being setup when *}
{* key segments not defined before opening a file. *}
{* Changed Error Handler and Error Display in fields in all *}
{* objects, and the corresponding parameters in methods, to *}
{* pointers. This allows nil objects. *}
{****************************************************************************}
Unit Btv;
{$F-}
{$V-}
{$X+}
{$A-}
{$DEFINE BCHECK} { Define this to check for Btrieve during initialization }
{$DEFINE BTRIEVE50} { Define this to make all opcodes new in V 5.0 available }
INTERFACE
USES
Dos, { Turbo DOS interface }
Btrv6, { Btrieve Interrupt Interface }
Tone; { This unit has substitute Delay and Sound routines for }
{ use with Turbo Vision and is used here instead of the }
{ Turbo CRT unit. The only routine needed is Delay. You }
{ may substitute CRT if desired. }
CONST
{----- Btrieve operation codes -----}
bOpen = 0;
bClose = 1;
bInsert = 2;
bUpdate = 3;
bDelete = 4;
bGetEqual = 5;
bGetNext = 6;
bGetPrev = 7;
bGetGreat = 8;
bGetGreatEqual = 9;
bGetLess = 10;
bGetLessEqual = 11;
bGetFirst = 12;
bGetLast = 13;
bCreate = 14;
bStat = 15;
bBeginTransaction = 19;
bEndTransaction = 20;
bAbortTransaction = 21;
bGetPosition = 22;
bGetDirect = 23;
bStepNext = 24;
bStop = 25;
bVersion = 26;
bUnlock = 27;
bReset = 28;
bSetOwner = 29;
bClearOwner = 30;
bCreateIndex = 31;
bDropIndex = 32;
bStepFirst = 33;
bStepLast = 34;
bStepPrev = 35;
bGetNextExt = 36;
bGetPrevExt = 37;
bStepNextExt = 38;
bStepPrevExt = 39;
bInsertExt = 40;
bGetKey = 50;
{----- Btrieve Status Codes -----}
bOkay = 0;
bInvalidOp = 1;
bIOerror = 2;
bFileNotOpen = 3;
bKeyNotFound = 4;
bDuplicateKey = 5;
bInvalidKey = 6;
bDifferentKey = 7;
bInvalidPos = 8;
bEOF = 9;
bKeyModifyErr = 10;
bInvalidName = 11;
bFileNotFound = 12;
bExtendedFileErr = 13;
bPreImageOpenErr = 14;
bPreImageIOErr = 15;
bExpansionErr = 16;
bCloseErr = 17;
bDiskFull = 18;
bUnRecoverableErr = 19;
bNotLoaded = 20;
bKeyBufferShort = 21;
bDataBufferShort = 22;
bPosBlockShort = 23;
bPageSizeErr = 24;
bCreateIOErr = 25;
bNumberKeys = 26;
bInvalidKeyPos = 27;
bRecordLenErr = 28;
bKeyLenErr = 29;
bNotBtrieveFile = 30;
bFileExtended = 31;
bExtendIOErr = 32;
bExtendNameErr = 34;
bDirectoryErr = 35;
bTransactionErr = 36;
bTransactionActive = 37;
bTransactionFileErr = 38;
bTransactionEndErr = 39;
bTransactionMaxFiles= 40;
bOpNotAllowed = 41;
bAcceleratedErr = 42;
bInvalidAddress = 43;
bNullKeypath = 44;
bBadKeyFlags = 45;
bFileAccessDenied = 46;
bMaxOpenFiles = 47;
bInvalidAltSequence = 48;
bKeyTypeErr = 49;
bOwnerIsSet = 50;
bInvalidOwner = 51;
bCacheWriteErr = 52;
bInvalidVersion = 53;
bVariablePageErr = 54;
bAutoIncrementErr = 55;
bBadIndex = 56;
bExpandedMemoryErr = 57;
bCompressBuffShort = 58;
bFileExists = 59;
bRejectMax = 60;
bWorkSpaceShort = 61;
bDescriptorErr = 62;
bExtInsertBuffErr = 63;
bFilterLimit = 64;
bFieldOffsetErr = 65;
bTTSabort = 74;
bDeadlock = 78;
bConflict = 80;
bLockErr = 81;
bLostPosition = 82;
bOutOfTransaction = 83;
bRecordInUse = 84;
bFileInUse = 85;
bFileTblFull = 86;
bHandleTblFull = 87;
bBadModeErr = 88;
bDeviceTableFull = 90;
bServerErr = 91;
bTranTableFull = 92;
bBadLockType = 93;
bPermissionErr = 94;
bSessionInvalid = 95;
bCommunicationErr = 96;
bDataMessageShort = 97;
bInternalTTSerr = 98;
bOutOfMemory = 120;
bDuplicateFilename = bOutOfMemory + 1;
bLoadInputErr = bDuplicateFilename + 1;
bLastError = bLoadInputErr;
{----- Btrieve constants -----}
bNormal = 0;
bRJustify = 1; { String justification types }
bLJustify = 2;
bNoOverWrite = -1; { File create mode }
bReadAccess = 1; { File owner access modes }
bWriteAccessEncrypt = 2;
bReadAccessEncrypt = 3;
bVariableLen = 1; { File flags }
bBlankTruncate = 2;
bPreallocate = 4;
bDataCompress = 8;
bKeyOnly = 16;
b10Free = 64;
b20Free = 128;
b30Free = 192;
bAccelerated = -1; { File open modes }
bReadOnly = -2;
bVerify = -3;
bExclusive = -4;
bDuplicates = 1; { Key flags }
bModifiable = 2;
bBinary = 4;
bNull = 8;
bSegmented = 16;
bAltSequence = 32;
bDescending = 64;
bSupplemental = 128;
bExtended = 256;
bManual = 512;
bString = 0; { Key types }
bInteger = 1;
bFloat = 2;
bDate = 3;
bTime = 4;
bDecimal = 5;
bMoney = 6;
bLogical = 7;
bNumeric = 8;
bBfloat = 9;
bLstring = 10;
bZstring = 11;
bUnsigned = 14;
bAutoIncrement = 15;
bNoLock = 0; { Lock types }
bSingleWait = 100;
bSingleNoWait = 200;
bMultipleWait = 300;
bMultipleNoWait = 400;
PosBlockSize = 128;
MaxSegments = 24; { maximum number of segments in a key }
MaxBuffSize : Word = 16 * 1024; { 16k max buffer size in bytes }
TYPE
AllErrors = bInvalidOp..bLastError;
{- a superset of all Btrieve errors allowing for customization }
ErrorSet = Set of AllErrors;
{- will hold Btrieve errors and possibly some custom error codes }
ErrorAction = (erAbort, erDone, erRetry);
{- the possible return states from an error }
{- these codes are returned by the error display routine }
PBytes = ^Bytes;
Bytes = Array[1..65534] of Byte;
{- define a byte array and pointer to make access easier }
PProgress = ^TProgress;
TProgress = Object
Constructor Init;
Procedure Display(Count : LongInt); Virtual;
end;
{- object to display progress for recover, save and load }
{ Btrieve key specs record }
KeySpec = record
KeyPos : Word; { position of key or segment in data }
KeyLen : Word; { length of the key or segment }
KeyFlags : Word; { key flags as defined by Btrieve }
KeyCount : LongInt; { not used except for STAT }
KeyType : Byte; { extended key type }
NullValue : Byte; { null character if defined }
Reserved : Array[1..4] of Byte;
end;
KeySpecArray = Array[1..MaxSegments] of KeySpec;
{ Our own key definition record }
KeyDef = record
KeyPos : Word; { position of key or segment in data }
KeyLen : Word; { length of the key or segment }
KeyFlags : Word; { key flags as defined by Btrieve }
KeyType : Byte; { extended key type }
NullValue : Byte; { null character if defined }
Justify : Byte; { lString justification type }
end;
KeyDefArray = Array[1..MaxSegments] of KeyDef;
{ Btrieve file specs record }
FileSpec = record
RecordLen : Word; { length of a record in the file }
PageSize : Word; { physical page size for file }
Indexes : Word; { number of keys }
Records : LongInt; { not used except for STAT }
FileFlags : Word; { file flags as defined by Btrieve }
Reserved : Array[1..2] of Byte;
FreePages : Word; { pages to pre allocate }
KeyBuff : KeySpecArray; { array of key info (one for each segment)}
Extra : Array[1..265] of Byte; { might be needed for alt. sequence}
end;
{ This is the object that will display errors to the user. }
{ This is an ABSTRACT object and should never be instantiated, you must }
{ define a descendant object that does what you want in each program. }
PErrorDisplay = ^ErrorDisplay;
ErrorDisplay = Object
Constructor Init;
{- init the error display }
Function Display(Error : Integer;
ErrorMsg : String;
OpCode : Byte;
OpCodeMsg : String;
FileName : PathStr
): ErrorAction; Virtual;
{- display the error, returns True if program should abort }
Destructor Done; Virtual;
{- destroy the object }
end;
{ This is the error object used by the file to trap IO errors. }
PErrorHandler = ^ErrorHandler;
ErrorHandler = Object
RetryCount : Word; { current number of retries on an error }
MaxRetry : Word; { maximum number of retries on an error }
RetryDelay : Word; { milliseconds between retries }
TrappedErrors : ErrorSet; { errors this object will handle }
ErrDisplay : PErrorDisplay;{ pointer to an error display object }
Constructor Init(DisplayObject : PErrorDisplay);
{- initialize the error object }
Function ErrorDispacther(ErrorCode : Integer;
OpCode : Byte;
FileName : PathStr
): ErrorAction; Virtual;
{- send errors and messages to the user error display }
Function Error(Status : Integer;
OpCode : Byte;
FileName : PathStr
): Boolean; Virtual;
{- check for errors and control the number of retries after an error }
Procedure SetMaxRetry(Retry : Word);
{- set the maximum retries per error }
Function GetMaxRetry: Word;
{- return the maximum retries per error }
Procedure ClearRetry;
{- clear the current count of retries }
Procedure SetDelay(Seconds : Word);
{- set the delay in seconds between retries }
Function GetDelay: Word;
{- return the delay in seconds between retries }
Procedure AddErrors(ErrorCodes : ErrorSet);
{- add an error to the set of errors trapped }
Procedure RemoveErrors(ErrorCodes : ErrorSet);
{- remove an error from the set of errors trapped }
Procedure SetErrors(ErrorCodes : ErrorSet);
{- set the entire trapped error set }
Procedure GetErrors(var ErrorCodes : ErrorSet);
{- get the trapped error set }
Function ErrorMsg(ErrorCode : Integer): String; Virtual;
{- return an error message for a Btrieve error code }
Function OpMsg(OpCode : Integer): String; Virtual;
{- return a message for a Btrieve operation code }
Destructor Done; Virtual;
{- destroy the object }
end;
{ This is the Btrieve file file interface object }
PBtrieveFile = ^BtrieveFile;
BtrieveFile = Object
Path : PathStr; { File name and path }
AltPath : PathStr; { Alternate collating seq. file }
Data : Pointer; { pointer to record data buffer }
DataSize : Word; { length of record data buffer }
Allocate : Boolean; { allocate data buffer memory }
BytesRead : Word; { number of bytes on last file read }
BytesToWrite: Word; { number of bytes to write to file }
Key : Pointer; { pointer to the file key buffer }
KeySize : Byte; { actual size of the key buffer }
SegmentCnt : Byte; { total number of key segments }
CurIndex : Word; { current key being used }
IndexCnt : Byte; { number of defined keys }
Status : Integer; { status of last Btrieve operation }
FileOpen : Boolean; { is the file open }
ErrHandler : PErrorHandler; { pointer to the error handler }
KeyList : KeyDefArray; { list of key definitions }
{ offset of 1st segment in each key }
KeyStart : Array[0..MaxSegments - 1] of Byte;
{ position block for Btrieve }
PosBlock : Array[1..PosBlockSize] of Byte;
VariableLen : Boolean; { does file use var length records }
SISegments : Byte;
ReadKeyDefs : Boolean;
CurrentKeySize : Byte;
Constructor Init(FilePath : PathStr;
ErrorObject : PErrorHandler;
DataBuf : Pointer;
DataBufSize : Word);
{- initialize a file object }
Destructor Done; Virtual;
{- destroy the object }
Procedure AddAltSequence(AltSeqPath : PathStr);
{- add an alternate collating sequence file }
Procedure AddKeySegment(Position : Word;
Size : Word;
Flags : Word;
KeyType : Byte;
NullValue : Byte;
Justify : Byte);
{- define a key segment }
Procedure Open(Mode : Integer;
Owner: String);
{- open the file }
Procedure Close;
{- close the file }
Procedure Create(Flags : Word;
RecordSize : Word;
PageSize : Word;
Pages : Word;
Mode : Integer);
{- create the file }
Procedure Clone(NewFilePath : PathStr;
Mode : Integer);
{- clone an empty copy of the file }
Function Error(ErrStatus : Integer;
OpCode : Byte;
FileName : PathStr
): Boolean;
{- call the error handler to check for errors }
Function Recover(NewFilePath : PathStr;
DisplayObj : PProgress): Integer;
{- copy all possible records to a new Btrieve file }
Function Save(NewFilePath : PathStr;
DisplayObj : PProgress): Integer;
{- write the contents of the file to a DOS file }
Function Load(InputFilePath : PathStr;
DisplayObj : PProgress): Integer;
{- read the contents of a DOS file and insert }
Procedure AddSupplKeySegment(Position : Word;
Size : Word;
Flags : Word;
KeyType : Byte;
NullValue : Byte;
Justify : Byte);
{- define a key segment for a supplemental index }
Procedure CreateIndex;
{- add a supplemental index to the file }
Procedure DropIndex(Index : Integer);
{- remove a supplemental index from the file }
Procedure SetOwner(Owner : String;
Mode : Integer);
{- set the file owner }
Procedure ClearOwner;
{- set the file owner }
Procedure SetKeyPath(Number : Word);
{- change the current file key path }
Procedure MakeKey(V1 : Pointer;
V2 : Pointer;
V3 : Pointer;
V4 : Pointer;
V5 : Pointer;
V6 : Pointer);
{- copy the passed fields into the key buffer }
Procedure Get(Op : Word;
Lock : Word);
{- read a record using by a key }
Procedure GetDirect(Lock : Word;
Position : LongInt);
{- read a record by file position }
Function GetPosition: LongInt;
{- return the position of the record }
Procedure UnlockAll(Lock : Word);
{- unlock all records in the file }
Procedure Insert;
{- add a new record to the file }
Procedure Update;
{- update an existing record in the file }
Procedure SetOutputSize(Size : Word);
{- use for variable length records only, sets the size of the
record to be written to the file }
Procedure AddErrors(ErrorCodes : ErrorSet);
{- add an error to the set of errors trapped }
Procedure RemoveErrors(ErrorCodes : ErrorSet);
{- remove an error from the set of errors trapped }
Procedure SetErrors(ErrorCodes : ErrorSet);
{- set the entire trapped error set }
Procedure GetErrors(var ErrorCodes : ErrorSet);
{- get the trapped error set }
Procedure Delete;
{- delete the current record }
Procedure ClearBuffer;
{- zero fill the file data buffer }
Procedure ClearKey;
{- zero fill the file key buffer }
Procedure FillKeyBuffer(var Buff; Size : Byte);
{- fill the key buffer from the data in Buff }
Procedure ChangeBufferSize(Size : Word);
{- change the size of the output buffer }
Procedure Stat(var FData : FileSpec);
{- get the file statistics }
Function bResult: Integer;
{- return the last IO status }
Function IsOpen: Boolean;
{- return True if the file is open }
Function NumberOfRecords: LongInt;
{- return the number of records in the file }
Procedure StartTransaction(Lock : Word);
Procedure EndTransaction;
Procedure AbortTransaction;
{- routines to control transaction processing }
Procedure Unload;
{- unload Btrieve }
Procedure Reset;
{- reset Btrieve }
Procedure Version(var Ver : Word;
var Rev : Word;
var OSFlag : Char);
{- get Btrieve version }
Procedure FixKeyStrings;
end;
Procedure CheckForBtrieve;
{============================================================================}
IMPLEMENTATION
Procedure Pad(var S : String;
Len : Byte);
{-Return a string right-padded to length len with blanks}
var
SLen : Byte Absolute S;
begin
if (SLen < Len) then
begin
FillChar(S[SLen + 1], Len - SLen, ' ');
SLen := Len;
end;
end;
Procedure LeftPad(var S : String;
Len : Byte);
{-Return a string left-padded to length len with blanks}
var
SLen : Byte Absolute S;
X : Byte;
begin
if (SLen < Len) then
begin
X := Len - SLen;
Move(S[1], S[X + 1], SLen);
FillChar(S[1], X, ' ');
SLen := Len;
end;
end;
Procedure Trim(var S : String);
{- Return a string with leading and trailing blanks removed }
var
I : Word;
SLen : Byte absolute S;
begin
while (SLen > 0) and (S[SLen] <= ' ') do
Dec(SLen);
I := 1;
while (I <= SLen) and (S[I] <= ' ') do
Inc(I);
if (I > 1) then
begin
SLen := SLen - I + 1;
Move(S[I], S[1], SLen);
end;
end;
{****************************************************************************
File Object
****************************************************************************}
{+--------------------------------------------------------------------------+}
{| Name : Init |}
{| Class : BtrieveFile |}
{| Purpose : Initialize the file object |}
{| Parameters : FilePath - Path name of the data file. |}
{| ErrorObject - Pointer to an error handler object. |}
{| DataBuf - Pointer to a data buffer, set to nil and |}
{| memory will be automatically allocated when |}
{| the file is opened. |}
{| DataBufSize - Size of what DataBuf points at, can be zero |}
{| if DataBuf is nil. |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Constructor BtrieveFile.Init(FilePath : PathStr;
ErrorObject : PErrorHandler;
DataBuf : Pointer;
DataBufSize : Word);
begin
Path := FilePath;
AltPath := '';
Data := DataBuf;
Allocate := (Data = nil);
if Allocate then
DataSize := 0
else
DataSize := DataBufSize;
BytesRead := 0;
BytesToWrite:= 0;
Key := nil;
KeySize := 0;
CurrentKeySize := 0;
SegmentCnt := 0;
SISegments := 0;
IndexCnt := 0;
Status := bOkay;
FileOpen := False;
ErrHandler := ErrorObject;
CurIndex := 0;
ReadKeyDefs := True;
FillChar(KeyList, SizeOf(KeyList), 0);
FillChar(KeyStart, SizeOf(KeyStart), 0);
FillChar(PosBlock, SizeOf(PosBlock), 0);
end;
{+--------------------------------------------------------------------------+}
{| Name : SetKeyPath |}
{| Class : BtrieveFile |}
{| Purpose : Set the number of the key that will be used for all read and|}
{| write operations. |}
{| Parameters : Number - the key path to be used |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.SetKeyPath(Number : Word);
begin
if (Number <= IndexCnt) then
CurIndex := Number;
end;
{+--------------------------------------------------------------------------+}
{| Name : AddAltSequence |}
{| Class : BtrieveFile |}
{| Purpose : Define the Path of a disk file that holds an alternate |}
{| collating sequence. |}
{| Parameters : AltSeqPath - Alt. sequence file path name. |}
{| Returns : none |}
{| Notes : This is an optional feature. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.AddAltSequence(AltSeqPath : PathStr);
begin
AltPath := AltSeqPath;
end;
{+--------------------------------------------------------------------------+}
{| Name : AddKeySegment |}
{| Class : BtrieveFile |}
{| Purpose : Define the next key segment. |}
{| Parameters : Position - where it starts in the key |}
{| Size - number of bytes in this segment |}
{| Flags - btrieve file flags |}
{| KeyType - btrieve key type |}
{| NullValue- null value for this segment |}
{| Justify - Applies to lStrings only. |}
{| 0 for the string to be left as is. |}
{| 1 for the string to be right justified. |}
{| 2 for the string to be left justified. |}
{| Returns : none |}
{| Notes : Segments must be defined in order. |}
{| Must be done once before a file created. May optionally be |}
{| done before a file is opened. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.AddKeySegment(Position : Word;
Size : Word;
Flags : Word;
KeyType : Byte;
NullValue : Byte;
Justify : Byte);
begin
{ Open will not read keys definitions from the file }
ReadKeyDefs := False;
{ if more segments are allowed }
if (SegmentCnt < MaxSegments) then
begin
{ increase the current key size by the size of this segment }
CurrentKeySize := CurrentKeySize + Size;
Inc(SegmentCnt);
{ if this is the first segment in the current key
then add to list of key starting segments
}
if (KeyStart[IndexCnt] = 0) then
KeyStart[IndexCnt] := SegmentCnt;
{ add it to the list of key definitions }
KeyList[SegmentCnt].KeyPos := Position;
KeyList[SegmentCnt].KeyLen := Size;
KeyList[SegmentCnt].KeyFlags := Flags;
KeyList[SegmentCnt].KeyType := KeyType;
KeyList[SegmentCnt].NullValue := NullValue;
KeyList[SegmentCnt].Justify := Justify;
{ if this is the end of all segments for the current key }
if (Flags And bSegmented = 0) then
begin
{ bump the number of keys }
Inc(IndexCnt);
{ find the largest key so far }
if (CurrentKeySize > KeySize) then
KeySize := CurrentKeySize;
{ set for the next key }
CurrentKeySize := 0;
end;
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : Open |}
{| Class : BtrieveFile |}
{| Purpose : Open a btrieve file |}
{| Parameters : Mode - mode to open the file in |}
{| Owner- up to 8 character file owner name |}
{| Returns : none |}
{| Notes : Allocates memory for key and data buffers. |}
{| If keys are not setup manually, then reads key defs from the|}
{| file. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Open(Mode : Integer;
Owner : String);
var
i,j : Byte;
OwnerLen: Word;
FName : Array[0..80] of Char;
FData : FileSpec;
begin
if not FileOpen then
begin
{ turn path and name into an ascii zero terminated string }
Move(Path[1], FName[0], Length(Path));
FName[Length(Path)] := Chr(0);
FillChar(FData, SizeOf(FData), 0);
OwnerLen := 0;
if (Owner <> '') then
begin
OwnerLen := Length(Owner);
if (OwnerLen > 8) then
OwnerLen := 8;
Move(Owner[1], FData, OwnerLen);
end;
Repeat
Status := Btrv(bOpen, PosBlock, FData, OwnerLen, FName, Mode);
Until (not Error(Status, bOpen, Path));
FileOpen := (Status = bOkay);
if FileOpen then
begin
{ read in all the file data needed }
Stat(FData);
if (Status = bOkay) then
begin
{ set some flags from the file definition }
IndexCnt := FData.Indexes;
VariableLen := ((FData.FileFlags and bVariableLen) <> 0);
{ write size defaults to fixed length size }
BytesToWrite:= FData.RecordLen;
{ if the keys were not setup manually then read from the file }
if ReadKeyDefs then
begin
{ check all keys for the largest key size }
SegmentCnt := 0;
for i := 1 to IndexCnt do
begin
{ set start of key segments for this key }
KeyStart[i] := SegmentCnt + 1;
Repeat
{ add this length to size of the current key }
Inc(SegmentCnt);
CurrentKeySize := CurrentKeySize +
FData.KeyBuff[SegmentCnt].KeyLen;
Until ((FData.KeyBuff[SegmentCnt].KeyFlags and bSegmented) = 0);
{ compare the size }
if (CurrentKeySize > KeySize) then
KeySize := CurrentKeySize;
{ set for the next key }
CurrentKeySize := 0;
end; {FOR}
{ move key segment data from stat buffer to key def buffer }
for i := 1 to SegmentCnt do
begin
KeyList[i].KeyPos := FData.KeyBuff[i].KeyPos;
KeyList[i].KeyLen := FData.KeyBuff[i].KeyLen;
KeyList[i].KeyFlags := FData.KeyBuff[i].KeyFlags;
KeyList[i].KeyType := FData.KeyBuff[i].KeyType;
KeyList[i].NullValue := FData.KeyBuff[i].NullValue;
KeyList[i].Justify := bNormal;
end; {FOR}
end;
{ allocate memory for the data and key buffers }
{ if Data does not point at anything then get }
{ some memory for it }
if Allocate then
begin
{ if variable length then allocate a bunch of memory }
{ else just allocate the minium needed }
if VariableLen then
DataSize := MaxBuffSize
else
DataSize := FData.RecordLen;
GetMem(Data, DataSize);
end;
GetMem(Key, KeySize);
if ((Data = nil) and (DataSize > 0)) or
((Key = nil) and (KeySize > 0)) then
begin
Status := bOutOfMemory;
Error(Status, bOpen, Path);
EXIT;
end;
{ clear the buffers }
FillChar(Data^, DataSize, ' ');
FillChar(Key^, KeySize, ' ');
CurrentKeySize := 0;
end;
end;
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : Create |}
{| Class : BtrieveFile |}
{| Purpose : Create a new file |}
{| Parameters : Flags - Btrieve file flags |}
{| RecordSize - length of the fixed length portion of record |}
{| PageSize - number of bytes in a file page |}
{| Pages - number of pages to preallocate to the file |}
{| Mode - indicates overwrite or warn mode |}
{| Returns : none |}
{| Notes : Make sure the keys have been defined. |}
{| Call Open immediately after Create. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Create(Flags : Word;
RecordSize : Word;
PageSize : Word;
Pages : Word;
Mode : Integer);
var
i : Integer;
BufSize : Word;
FName : Array[0..80] of Char;
Buff : FileSpec;
Temp : Array[1..1024] of Byte Absolute Buff;
AltFile : File;
begin
{ clear the data buffer }
FillChar(Buff, SizeOf(Buff), 0);
{ copy the file info to the data buffer }
Buff.RecordLen := RecordSize;
Buff.PageSize := PageSize;
Buff.Indexes := IndexCnt;
Buff.FileFlags := Flags;
Buff.FreePages := Pages;
{ copy the key info for each segment to the data buffer }
for i := 1 to SegmentCnt do
begin
Buff.KeyBuff[i].KeyPos := KeyList[i].KeyPos;
Buff.KeyBuff[i].KeyLen := KeyList[i].KeyLen;
Buff.KeyBuff[i].KeyFlags := KeyList[i].KeyFlags;
Buff.KeyBuff[i].KeyType := KeyList[i].KeyType;
Buff.KeyBuff[i].NullValue := KeyList[i].NullValue;
end;
{ calculate the buffer size so far }
{ Segments * Segment data size + file data size }
BufSize := SegmentCnt * SizeOf(KeySpec) + 16;
{ read the alternate collating sequence if any }
{$I-}
if (AltPath <> '') then
begin
System.Assign(AltFile, AltPath);
System.Reset(AltFile, 1);
if (IoResult = 0) then
begin
System.BlockRead(AltFile, Temp[BufSize+1], 265);{ Read file }
System.Close(AltFile);
BufSize := BufSize + 265;
AltPath := '';
i := IoResult;
end;
end;
{$I+}
{ turn path and name into an ascii zero terminated string }
Move(Path[1], FName[0], Length(Path));
FName[Length(Path)] := Chr(0);
Repeat
Status := Btrv(bCreate, PosBlock, Buff, BufSize, FName, Mode);
Until (not Error(Status, bCreate, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : Recover |}
{| Class : BtrieveFile |}
{| Purpose : Read records and write to a new file. |}
{| Parameters : NewFilePath - File path name of new file |}
{| DisplayObj - pointer to a object that can display progress |}
{| Returns : Integer - zero if sucessful |}
{| Notes : Reads in Read Only mode and writes to new file. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.Recover(NewFilePath : PathStr;
DisplayObj : PProgress): Integer;
var
OutFile : BtrieveFile;
X : Byte;
Total : LongInt;
begin
if (Path = NewFilePath) then
begin
Recover := bDuplicateFilename;
EXIT;
end;
Clone(NewFilePath, bNoOverWrite);
if (Status <> bOkay) then
begin
Recover := Status;
EXIT;
end;
OutFile.Init(NewFilePath, ErrHandler, Data, DataSize);
OutFile.Open(bAccelerated, '');
{$IFNDEF BTRIEVE50}
Get(bStepNext, bNoLock);
{$ELSE}
Get(bStepFirst, bNoLock);
{$ENDIF}
X := 0;
Total := 0;
While (Status <> bEOF) and (OutFile.bResult = bOkay) do
begin
if (Status = bOkay) then
begin
OutFile.Insert;
Inc(X);
Inc(Total);
if (X = 10) then
begin
if (DisplayObj <> nil) then
DisplayObj^.Display(Total);
X := 0;
end;
end;
Get(bStepNext, bNoLock);
end; {WHILE}
if (DisplayObj <> nil) then
DisplayObj^.Display(Total);
if (Status <> bEOF) then
Recover := Status
else if (OutFile.bResult <> bOkay) then
Recover := OutFile.bResult
else
Recover := 0;
OutFile.Close;
end;
{+--------------------------------------------------------------------------+}
{| Name : Save |}
{| Class : BtrieveFile |}
{| Purpose : Save records to a DOS file. |}
{| Parameters : NewFilePath - File path name of new file |}
{| DisplayObj - pointer to a object that can display progress |}
{| Returns : Integer - zero if sucessful |}
{| Notes : Writes records to a DOS file. The file will be in the same |}
{| format that the BUTIL RECOVER utility creates. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.Save(NewFilePath : PathStr;
DisplayObj : PProgress): Integer;
var
X : Byte;
Err : Integer;
Total : LongInt;
St : String[6];
OutFile : File;
begin
if (Path = NewFilePath) then
begin
Save := bDuplicateFilename;
EXIT;
end;
{$I-}
Assign(OutFile, NewFilePath);
ReWrite(OutFile, 1);
Err := IoResult;
{$IFNDEF BTRIEVE50}
Get(bStepNext, bNoLock);
{$ELSE}
Get(bStepFirst, bNoLock);
{$ENDIF}
X := 0;
Total := 0;
While (Status <> bEOF) and (Err = 0) do
begin
if (Status = bOkay) then
begin
Str(BytesRead, St);
St := St + ',';
BlockWrite(OutFile, St[1], Length(St));
Err := IoResult;
if (Err = 0) then
begin
BlockWrite(OutFile, Data^, BytesRead);
Err := IoResult;
end;
if (Err = 0) then
begin
St := #13#10;
BlockWrite(OutFile, St[1], 2);
Err := IoResult;
Inc(Total);
Inc(X);
if (X = 10) then
begin
if (DisplayObj <> nil) then
DisplayObj^.Display(Total);
X := 0;
end;
end;
end;
Get(bStepNext, bNoLock);
end; {WHILE}
St := #26;
BlockWrite(OutFile, St[1], 1);
if (DisplayObj <> nil) then
DisplayObj^.Display(Total);
if (Err = 0) then
Err := IoResult;
if (Status <> bEOF) then
Save := Status
else if (Err <> 0) then
Save := Err
else
Save := 0;
System.Close(OutFile);
{$I+}
end;
{+--------------------------------------------------------------------------+}
{| Name : Load |}
{| Class : BtrieveFile |}
{| Purpose : Load records from a DOS file. |}
{| Parameters : InputFilePath - File path name of new file |}
{| DisplayObj - pointer to a object that can display progress |}
{| Returns : Integer - zero if sucessful |}
{| Notes : Reads records from a DOS file and inserts. The file must be |}
{| in the same format that the BUTIL RECOVER utility creates. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.Load(InputFilePath : PathStr;
DisplayObj : PProgress): Integer;
var
X : Byte;
Ch : Char;
Err : Integer;
Size : Word;
Total : LongInt;
St : String[5];
InFile : File;
Buff : Pointer;
begin
GetMem(Buff, $FFF0); {Get max buffer size of 64K}
if (Buff = nil) then
begin
Load := bOutOfMemory;
EXIT;
end;
{$I-}
Assign(InFile, InputFilePath);
System.Reset(InFile, 1);
Err := IoResult;
X := 0;
Total := 0;
While (Status = bOkay) and (Err = 0) and not EOF(InFile) do
begin
BlockRead(InFile, Ch, 1);
Err := IoResult;
St := '';
While (Ch <> ',') and (Ch <> ' ') and (Ch <> #26) and (Err = 0) do
begin
St := St + Ch;
BlockRead(InFile, Ch, 1);
Err := IoResult;
end;
if (Err = 0) and (Ch <> #26) then
begin
Val(St, Size, Err);
if (Err <> 0) then
begin
Load := bLoadInputErr;
EXIT;
end
else
begin
BlockRead(InFile, Buff^, Size);
Err := IoResult;
if (Err = 0) then
begin
BlockRead(InFile, St, 2);
Err := IoResult;
end;
if not VariableLen and (Size > DataSize) then
Size := DataSize;
Move(Buff^, Data^, Size);
SetOutputSize(Size);
Insert;
Inc(X);
Inc(Total);
if (X = 10) then
begin
if (DisplayObj <> nil) then
DisplayObj^.Display(Total);
X := 0;
end;
end;
end;
end; {WHILE}
if (DisplayObj <> nil) then
DisplayObj^.Display(Total);
if (Status <> bOkay) then
Load := Status
else if (Err <> 0) then
Load := Err
else
Load := 0;
System.Close(InFile);
{$I+}
end;
{+--------------------------------------------------------------------------+}
{| Name : Clone |}
{| Class : BtrieveFile |}
{| Purpose : Clone a file from an existing file. |}
{| Parameters : NewFilePath - File path name new file |}
{| Mode - indicates overwrite or warn mode |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Clone(NewFilePath : PathStr;
Mode : Integer);
var
FName : Array[0..SizeOf(PathStr) - 1] of Char;
FData : FileSpec;
PBlock: Array[1..PosBlockSize] of Byte;
begin
if (Path = NewFilePath) then
begin
Status := bDuplicateFilename;
EXIT;
end;
Stat(FData);
{ turn pathname into an ascii zero terminated string }
Move(NewFilePath[1], FName[0], Length(NewFilePath));
FName[Length(NewFilePath)] := Chr(0);
Repeat
Status := Btrv(bCreate, PBlock, FData, BytesRead, FName, Mode);
Until (not Error(Status, bCreate, NewFilePath));
end;
{+--------------------------------------------------------------------------+}
{| Name : AddSupplKeySegment |}
{| Class : BtrieveFile |}
{| Purpose : Define the next key segment for a supplemental index. |}
{| Parameters : Position - where it starts in the key |}
{| Size - number of bytes in this segment |}
{| Flags - btrieve file flags |}
{| KeyType - btrieve key type |}
{| NullValue- null value for this segment |}
{| Justify - Applies to lStrings only. |}
{| 0 for the string to be left as is. |}
{| 1 for the string to be right justified. |}
{| 2 for the string to be left justified. |}
{| Returns : none |}
{| Notes : Segments must be defined in order. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.AddSupplKeySegment(Position : Word;
Size : Word;
Flags : Word;
KeyType : Byte;
NullValue : Byte;
Justify : Byte);
begin
{ if more segments are allowed }
if (SegmentCnt + SISegments < MaxSegments) then
begin
{ increase the current key size by the size of this segment }
CurrentKeySize := CurrentKeySize + Size;
Inc(SISegments);
{ if this is the first segment in the current key
then add to list of key starting segments
}
if (KeyStart[IndexCnt] = 0) then
KeyStart[IndexCnt] := SegmentCnt + 1;
{ add it to the list of key definitions }
KeyList[SegmentCnt + SISegments].KeyPos := Position;
KeyList[SegmentCnt + SISegments].KeyLen := Size;
KeyList[SegmentCnt + SISegments].KeyFlags := Flags;
KeyList[SegmentCnt + SISegments].KeyType := KeyType;
KeyList[SegmentCnt + SISegments].NullValue := NullValue;
KeyList[SegmentCnt + SISegments].Justify := Justify;
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : CreateIndex |}
{| Class : BtrieveFile |}
{| Purpose : Create a supplemental index for the file. |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.CreateIndex;
var
i : Integer;
BufSize : Word;
Buff : KeySpecArray;
Temp : Array[1..1024] of Byte Absolute Buff;
AltFile : File;
begin
{ move all the key defs to the data buffer }
for i := 1 to SISegments do
begin
Buff[i].KeyPos := KeyList[i + SegmentCnt].KeyPos;
Buff[i].KeyLen := KeyList[i + SegmentCnt].KeyLen;
Buff[i].KeyFlags := KeyList[i + SegmentCnt].KeyFlags;
Buff[i].KeyType := KeyList[i + SegmentCnt].KeyType;
Buff[i].NullValue := KeyList[i + SegmentCnt].NullValue;
end;
{ calculate the buffer size so far }
{ Segments * Segment data size + file data size }
BufSize := SISegments * SizeOf(KeySpec);
{ read the alternate collating sequence if any }
{$I-}
if (AltPath <> '') then
begin
System.Assign(AltFile, AltPath);
System.Reset(AltFile, 1);
if (IoResult = 0) then
begin
System.BlockRead(AltFile, Temp[BufSize+1], 265);{ Read file }
System.Close(AltFile);
BufSize := BufSize + 265;
i := IoResult;
end;
end;
{$I+}
Repeat
Status := Btrv(bCreateIndex, PosBlock, Buff, BufSize, i, i);
Until (not Error(Status, bCreateIndex, Path));
if (Status = bOkay) then
begin
{ bump the number of keys and segments }
Inc(IndexCnt);
Inc(SegmentCnt, SISegments);
{ resize the key buffer }
if (CurrentKeySize > KeySize) then
begin
FreeMem(Key, KeySize);
KeySize := CurrentKeySize;
CurrentKeySize := 0;
GetMem(Key, KeySize);
if ((Key = nil) and (KeySize > 0)) then
begin
Status := bOutOfMemory;
Error(Status, bCreateIndex, Path);
end;
end;
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : DropIndex |}
{| Class : BtrieveFile |}
{| Purpose : Drop a supplemental index from the file. |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.DropIndex(Index : Integer);
var
I : Integer;
W : Word;
begin
Repeat
Status := Btrv(bDropIndex, PosBlock, I, W, I, Index);
Until (not Error(Status, bDropIndex, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : ChangeBufferSize |}
{| Class : BtrieveFile |}
{| Purpose : Change the size of the data buffer. |}
{| Parameters : Size - new buffer size |}
{| Returns : none |}
{| Notes : ONLY valid for objects that allocated buffer memory. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.ChangeBufferSize(Size : Word);
begin
if (Size = DataSize) then EXIT;
if (Size > MaxAvail) then
Size := MaxAvail;
if (Data <> nil) then
FreeMem(Data, DataSize);
DataSize := Size;
GetMem(Data, DataSize);
if ((Data = nil) and (DataSize > 0)) then
begin
Status := bOutOfMemory;
Error(Status, 0, Path);
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : SetOwner |}
{| Class : BtrieveFile |}
{| Purpose : Set the owner name and access mode for the file. |}
{| Parameters : Owner - up to 8 character owner name |}
{| Mode - Access mode for file |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.SetOwner(Owner : String;
Mode : Integer);
var
BufSize : Word;
Buff : Array[1..9] of Char;
begin
Trim(Owner);
if (Owner = '') then EXIT;
FillChar(Buff, SizeOf(Buff), 0);
BufSize := Length(Owner);
if (BufSize > 8) then
BufSize := 8;
Move(Owner[1], Buff[1], BufSize);
Repeat
Status := Btrv(bSetOwner, PosBlock, Buff, BufSize, Buff, Mode);
Until (not Error(Status, bSetOwner, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : ClearOwner |}
{| Class : BtrieveFile |}
{| Purpose : Clear the owner name and access mode for the file. |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.ClearOwner;
var
I : Integer;
W : Word;
begin
Repeat
Status := Btrv(bClearOwner, PosBlock, I, W, I, I);
Until (not Error(Status, bClearOwner, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : Close |}
{| Class : BtrieveFile |}
{| Purpose : Close a btrieve file |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Call Done to destroy the object and free memory. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Close;
var
I : Integer;
W : Word;
begin
if FileOpen then
begin
Repeat
Status := Btrv(bClose, PosBlock, I, W, I, 0);
Until (not Error(Status, bClose, Path));
FileOpen := not (Status = bOkay);
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : Error |}
{| Class : BtrieveFile |}
{| Purpose : Call the error handler object. |}
{| Parameters : Status - the last btrieve status code |}
{| OpCode - btrieve operation that generate error |}
{| FileName - file the error occured with |}
{| Returns : TRUE as long as there is still an error. |}
{| Notes : If an error handler object has not been assigned this will |}
{| always return FALSE. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.Error(ErrStatus: Integer;
OpCode : Byte;
FileName : PathStr
): Boolean;
begin
if (ErrHandler <> nil) then
Error := ErrHandler^.Error(ErrStatus, OpCode, FileName)
else
Error := False;
end;
{+--------------------------------------------------------------------------+}
{| Name : Get |}
{| Class : BtrieveFile |}
{| Purpose : Read a record |}
{| Parameters : Op - type of read operation |}
{| Lock - type of lock |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Get(Op : Word;
Lock : Word);
begin
BytesRead := DataSize;
Repeat
Status := Btrv(Op + Lock, PosBlock, Data^, BytesRead, Key^, CurIndex);
Until (not Error(Status, Op, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : GetDirect |}
{| Class : BtrieveFile |}
{| Purpose : Read a record at a speific file position |}
{| Parameters : Lock - type of lock |}
{| Position - record position in the file as returned by |}
{| a call to GetPosition. |}
{| Returns : none |}
{| Notes : Establishes index position for current key path. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.GetDirect(Lock : Word;
Position : LongInt);
begin
BytesRead := DataSize;
Move(Position, Data^, 4);
Repeat
Status := Btrv(bGetDirect + Lock, PosBlock, Data^, BytesRead, Key^, CurIndex);
Until (not Error(Status, bGetDirect, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : Insert |}
{| Class : BtrieveFile |}
{| Purpose : Add a new record to the file |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Automatically pads or right justifies key strings. |}
{| When writing variable length records make sure to set the |}
{| output buffer size. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Insert;
begin
FixKeyStrings;
Repeat
Status := Btrv(bInsert, PosBlock, Data^, BytesToWrite, Key^, CurIndex);
Until (not Error(Status, bInsert, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : Update |}
{| Class : BtrieveFile |}
{| Purpose : Update an existing record in the file |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Updates the last record retrieved. |}
{| Automatically pads or right justifies key strings. |}
{| When writing variable length records make sure to set the |}
{| output buffer size. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Update;
begin
FixKeyStrings;
Repeat
Status := Btrv(bUpdate, PosBlock, Data^, BytesToWrite, Key^, CurIndex);
Until (not Error(Status, bUpdate, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : Delete |}
{| Class : BtrieveFile |}
{| Purpose : Delete a record |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Deletes the current record, i.e. last record retrieved. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Delete;
var
I : Integer;
begin
BytesRead := DataSize;
Repeat
Status := Btrv(bDelete, PosBlock, I, BytesRead, I, 0);
Until (not Error(Status, bDelete, Path));
BytesRead := 0;
end;
{+--------------------------------------------------------------------------+}
{| Name : GetPosition |}
{| Class : BtrieveFile |}
{| Purpose : Get the physical file position of a record |}
{| Parameters : none |}
{| Returns : Returns the position of the last record retrieved. |}
{| Returns a -1 if any error occurs. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.GetPosition: LongInt;
var
I : Integer;
Pos : LongInt;
BufSize : Word;
begin
BufSize := 4;
Repeat
Status := Btrv(bGetPosition, PosBlock, Pos, BufSize, I, 0);
Until (not Error(Status, bGetPosition, Path));
if (Status = bOkay) then
GetPosition := Pos
else
GetPosition := -1;
end;
{+--------------------------------------------------------------------------+}
{| Name : UnlockAll |}
{| Class : BtrieveFile |}
{| Purpose : Unlock all records in the file. |}
{| Parameters : Lock - if <= 200 then single locks are active |}
{| if > 200 then multiple locks are active |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.UnlockAll(Lock : Word);
var
I : Integer;
W : Word;
KeyNum: Integer;
begin
if (Lock <= bSingleNoWait) then
KeyNum := 1
else
KeyNum := -2;
Repeat
Status := Btrv(bUnlock, PosBlock, I, W, I, KeyNum);
Until (not Error(Status, bUnlock, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : AddError |}
{| Class : BtrieveFile |}
{| Purpose : Add an error to the trapped error set |}
{| Parameters : ErrorCode - btrieve status code to add |}
{| Returns : none |}
{| Notes : All errors except bEOF are trapped by default |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.AddErrors(ErrorCodes : ErrorSet);
begin
if (ErrHandler <> nil) then
ErrHandler^.AddErrors(ErrorCodes);
end;
{+--------------------------------------------------------------------------+}
{| Name : RemoveError |}
{| Class : BtrieveFile |}
{| Purpose : Remove a error form the trapped errors |}
{| Parameters : ErrorCode - btrieve status code to remove |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : bOkay will not be removed. |}
{| All errors except bEOF are trapped by default |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.RemoveErrors(ErrorCodes : ErrorSet);
begin
if (ErrHandler <> nil) then
ErrHandler^.RemoveErrors(ErrorCodes);
end;
{+--------------------------------------------------------------------------+}
{| Name : SetErrors |}
{| Class : BtrieveFile |}
{| Purpose : Make the set of all trapped errors. |}
{| Parameters : ErrorCodes - A set of btrieve status codes to become the new|}
{| trapped error set. |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.SetErrors(ErrorCodes : ErrorSet);
begin
if (ErrHandler <> nil) then
ErrHandler^.SetErrors(ErrorCodes);
end;
{+--------------------------------------------------------------------------+}
{| Name : GetErrors |}
{| Class : BtrieveFile |}
{| Purpose : Return the set of all trapped errors. |}
{| Parameters : ErrorCodes - The set of btrieve status codes currently |}
{| trapped. |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.GetErrors(var ErrorCodes : ErrorSet);
begin
if (ErrHandler <> nil) then
ErrHandler^.GetErrors(ErrorCodes)
else
ErrorCodes := [];
end;
{+--------------------------------------------------------------------------+}
{| Name : ClearBuffer |}
{| Class : BtrieveFile |}
{| Purpose : Fill the file data buffer with zeros. |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Use this to clear the buffer before you add new records. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.ClearBuffer;
begin
FillChar(Data^, DataSize, 0);
BytesRead := 0;
end;
{+--------------------------------------------------------------------------+}
{| Name : SetOutputSize |}
{| Class : BtrieveFile |}
{| Purpose : Set the number of bytes in the output buffer. |}
{| This is used to set the buffer size before writing a |}
{| variable length record. |}
{| Parameters : Size - number of bytes in the output buffer |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.SetOutputSize(Size : Word);
begin
BytesToWrite := Size;
end;
{+--------------------------------------------------------------------------+}
{| Name : ClearKey |}
{| Class : BtrieveFile |}
{| Purpose : Fill the file key buffer with zeros. |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.ClearKey;
begin
FillChar(Key^, KeySize, 0);
end;
{+--------------------------------------------------------------------------+}
{| Name : FillKeyBuffer |}
{| Class : BtrieveFile |}
{| Purpose : Fill the file key buffer with with supplied data. |}
{| Parameters : Buff - some data to move into the key buffer |}
{| Size - how much data to move into the key buffer |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.FillKeyBuffer(var Buff; Size : Byte);
begin
if (Size > KeySize) then
Size := KeySize;
ClearKey;
Move(Buff, Key^, Size);
end;
{+--------------------------------------------------------------------------+}
{| Name : MakeKey |}
{| Class : BtrieveFile |}
{| Purpose : Build a key for reading a record from the file. |}
{| Parameters : KeyNumber - Which path are we building for. |}
{| V1..V6 - Pointers to the data to make into a file key. |}
{| Returns : none |}
{| Notes : Make sure to pass the addresses in the correct order for the|}
{| specified path. This routine will left or right justify |}
{| strings as defined by AddKeySegment. Pass unused pointers as|}
{| nil. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.MakeKey(V1 : Pointer;
V2 : Pointer;
V3 : Pointer;
V4 : Pointer;
V5 : Pointer;
V6 : Pointer);
var
ParamPtr : Pointer;
Param : Byte;
KeyPos : Byte;
SegIndex : Byte;
Segmented : Word;
St : String;
x : Byte;
begin
{ clear the key buffer }
FillChar(Key^, KeySize, 0);
{ init the key buffer offset, the current parameter number, }
{ and the offset into the list of key segment definitions }
KeyPos := 1;
Param := 1;
SegIndex:= KeyStart[CurIndex];
Repeat
{ point to the current parameter }
Case Param of
1 : ParamPtr := V1;
2 : ParamPtr := V2;
3 : ParamPtr := V3;
4 : ParamPtr := V4;
5 : ParamPtr := V5;
6 : ParamPtr := V6;
end;
{ pascal strings get some special processing }
Case KeyList[SegIndex].KeyType of
bLstring :
begin
St := String(ParamPtr^);
Case KeyList[SegIndex].Justify of
bRJustify :
begin
Trim(St);
LeftPad(St, KeyList[SegIndex].KeyLen - 1)
end;
bLJustify :
begin
Trim(St);
Pad(St, KeyList[SegIndex].KeyLen - 1);
end;
end; {CASE}
Move(St[0], PBytes(Key)^[KeyPos], KeyList[SegIndex].KeyLen);
end;
{ just copy everything else over to the key buffer }
else
begin
Move(ParamPtr^, PBytes(Key)^[KeyPos], KeyList[SegIndex].KeyLen);
end; {CASE ELSE}
end; {CASE}
{ get the value of the segment bit from the key def }
Segmented := KeyList[SegIndex].KeyFlags AND bSegmented;
{ bump the position in the key buffer }
KeyPos := KeyPos + KeyList[SegIndex].KeyLen;
{ move to next segment and parameter }
Inc(SegIndex);
Inc(Param);
Until (Segmented = 0); { we have copied the last segment }
end;
{+--------------------------------------------------------------------------+}
{| Name : FixKeyStrings |}
{| Class : BtrieveFile |}
{| Purpose : Left or right justify all key string fields as needed. |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.FixKeyStrings;
var
i : Byte;
St : String;
begin
{ proccess all key segments }
for i := 1 to SegmentCnt do
begin
{ pascal strings get some special processing }
Case KeyList[i].KeyType of
bLstring :
begin
{ pull it out of the buffer }
Move(PBytes(Data)^[KeyList[i].KeyPos], St[0], KeyList[i].KeyLen);
Case KeyList[i].Justify of
bRJustify :
begin
Trim(St);
LeftPad(St, KeyList[i].KeyLen - 1)
end;
bLJustify :
begin
Trim(St);
Pad(St, KeyList[i].KeyLen - 1);
end;
end; {CASE}
{ put it back in the buffer }
Move(St[0], PBytes(Data)^[KeyList[i].KeyPos], KeyList[i].KeyLen);
end;
end; {CASE}
end; {FOR}
end;
{+--------------------------------------------------------------------------+}
{| Name : IsOpen |}
{| Class : BtrieveFile |}
{| Purpose : Indicate if the file has been opened. |}
{| Parameters : none |}
{| Returns : Boolean - TRUE if the file is open. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.IsOpen;
begin
IsOpen := FileOpen;
end;
{+--------------------------------------------------------------------------+}
{| Name : NumberOfRecords |}
{| Class : BtrieveFile |}
{| Purpose : Get the number of records in the file. |}
{| Parameters : none |}
{| Returns : LongInt - Number of records in the file. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.NumberOfRecords: LongInt;
var
BufSize : Word;
Buffer1 : Array[1..1024] of Byte;
Temp : FileSpec Absolute Buffer1;
Buffer2 : Array[1..64] of Byte;
begin
BufSize := SizeOf(Buffer1);
Repeat
Status := Btrv(bStat, PosBlock, Buffer1, BufSize, Buffer2, 0);
Until (not Error(Status, bStat, Path));
if (Status = bOkay) then
NumberOfRecords := Temp.Records
else
NumberOfRecords := -1;
end;
{+--------------------------------------------------------------------------+}
{| Name : bResult |}
{| Class : BtrieveFile |}
{| Purpose : Get the status of the file. |}
{| Parameters : none |}
{| Returns : Integer - Last btrieve error code. |}
{| Notes : Error is not cleared, so it can be checked multiple times. |}
{+--------------------------------------------------------------------------+}
Function BtrieveFile.bResult: Integer;
begin
bResult := Status;
end;
{+--------------------------------------------------------------------------+}
{| Name : Done |}
{| Class : BtrieveFile |}
{| Purpose : Destroy the object. |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Destructor BtrieveFile.Done;
begin
if (Key <> nil) then
FreeMem(Key, KeySize);
if Allocate and (Data <> nil) then
FreeMem(Data, DataSize);
end;
{+--------------------------------------------------------------------------+}
{| Name : StartTransaction |}
{| Class : BtrieveFile |}
{| Purpose : Begin a btrieve transaction |}
{| Parameters : Lock - Locking state for the transaction. By default a value|}
{| of bNoLock will start a transaction that waits on any|}
{| other transactions. Pass bSingleNoWait (200) or |}
{| bMultipleNoWait (400) for a no wait file lock. |}
{| Returns : none |}
{| Notes : Don't actually need an open file to execute this method. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.StartTransaction(Lock : Word);
var
I : Integer;
W : Word;
begin
Repeat
Status := Btrv(bBeginTransaction, I, I, W, I, 0);
Until (not Error(Status, bBeginTransaction + Lock, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : EndTransaction |}
{| Class : BtrieveFile |}
{| Purpose : End a btrieve transaction |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Don't actually need an open file to execute this method. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.EndTransaction;
var
I : Integer;
W : Word;
begin
Repeat
Status := Btrv(bEndTransaction, I, I, W, I, 0);
Until (not Error(Status, bEndTransaction, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : AbortTransaction |}
{| Class : BtrieveFile |}
{| Purpose : Abort a btrieve transaction |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Don't actually need an open file to execute this method. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.AbortTransaction;
var
I : Integer;
W : Word;
begin
Repeat
Status := Btrv(bAbortTransaction, I, I, W, I, 0);
Until (not Error(Status, bAbortTransaction, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : Stat |}
{| Class : BtrieveFile |}
{| Purpose : Execute the stat operation. |}
{| Parameters : FDATA - will hold the statistics for the file |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Stat(var FData : FileSpec);
var
FName : Array[1..128] of Char;
begin
BytesRead := SizeOf(FData);
Repeat
Status := Btrv(bStat, PosBlock, FData, BytesRead, FName, 0);
Until (not Error(Status, bStat, Path));
end;
{+--------------------------------------------------------------------------+}
{| Name : Version |}
{| Class : BtrieveWorkStation |}
{| Purpose : Get the version of btrieve being used |}
{| Parameters : ver - major version number |}
{| rev - minor version number |}
{| flag- an "N" indicates a network version |}
{| Returns : none |}
{| Notes : Don't actually need an open file to execute this method. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Version(var Ver : Word;
var Rev : Word;
var OSFlag : Char);
var
I : Integer;
BufSize : Word;
Buffer : Array[0..19] of Byte;
begin
BufSize := 20; { init length }
Repeat
Status := Btrv(bVersion, I, Buffer, BufSize, I, 0);
Until (not Error(Status, bVersion, ''));
Move(Buffer[0], Ver, 2); { set version number }
Move(Buffer[2], Rev, 2); { set revision number }
Move(Buffer[4], OSFlag,1); { set network flag }
end;
{+--------------------------------------------------------------------------+}
{| Name : Unload |}
{| Class : BtrieveFile |}
{| Purpose : Unload btrieve. |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Don't actually need an open file to execute this method. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Unload;
var
I : Integer;
W : Word;
begin
Repeat
Status := Btrv(bStop, I, I, W, I, 0);
Until (not Error(Status, bStop, ''));
end;
{+--------------------------------------------------------------------------+}
{| Name : Reset |}
{| Class : BtrieveFile |}
{| Purpose : Reset btrieve and release all workstation resources. |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Don't actually need an open file to execute this method. |}
{+--------------------------------------------------------------------------+}
Procedure BtrieveFile.Reset;
var
I : Integer;
W : Word;
begin
Repeat
Status := Btrv(bReset, I, I, W, I, 0);
Until (not Error(Status, bStop, ''));
end;
{****************************************************************************
Error Handler Object
****************************************************************************}
{+--------------------------------------------------------------------------+}
{| Name : Init |}
{| Class : ErrorHandler |}
{| Purpose : Initialize an errror handler object |}
{| Parameters : DisplayObject - pointer to user defined error display object|}
{| Returns : none |}
{| Notes : Sets the default error set to all errors except bEOF and |}
{| bKeyNotFound. |}
{+--------------------------------------------------------------------------+}
Constructor ErrorHandler.Init(DisplayObject : PErrorDisplay);
begin
RetryCount := 0;
MaxRetry := 5;
{ turn seconds into milliseconds }
RetryDelay := 5000;
ErrDisplay := DisplayObject;
{ init Errors handled to all except End Of File }
TrappedErrors := [bInvalidOp..bLastError] - [bEOF];
end;
{+--------------------------------------------------------------------------+}
{| Name : Done |}
{| Class : ErrorHandler |}
{| Purpose : Destroy the object |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Destructor ErrorHandler.Done;
begin
end;
{+--------------------------------------------------------------------------+}
{| Name : ErrorMsg |}
{| Class : ErrorHandler |}
{| Purpose : Return the message for a btrieve error code |}
{| Parameters : ErrorCode - a btrieve status code |}
{| Returns : A message string |}
{+--------------------------------------------------------------------------+}
Function ErrorHandler.ErrorMsg(ErrorCode : Integer): String;
begin
Case ErrorCode of
bOkay : ErrorMsg := 'No error';
bInvalidOp : ErrorMsg := 'Invalid operation';
bIOerror : ErrorMsg := 'I/O error';
bFileNotOpen : ErrorMsg := 'File not open';
bKeyNotFound : ErrorMsg := 'Key value not found';
bDuplicateKey : ErrorMsg := 'Duplicate keys not allowed';
bInvalidKey : ErrorMsg := 'Invalid key number';
bDifferentKey : ErrorMsg := 'Different key number from previous read';
bInvalidPos : ErrorMsg := 'Invalid file positioning';
bEOF : ErrorMsg := 'End of file';
bKeyModifyErr : ErrorMsg := 'Key data may not be modified';
bInvalidName : ErrorMsg := 'Invalid file name';
bFileNotFound : ErrorMsg := 'File not found';
bPreImageOpenErr : ErrorMsg := 'Pre-Image file open error';
bPreImageIOErr : ErrorMsg := 'Pre-Image file I/O error';
bExpansionErr : ErrorMsg := 'Expansion file error';
bCloseErr : ErrorMsg := 'Close error';
bDiskFull : ErrorMsg := 'Disk full';
bUnRecoverableErr : ErrorMsg := 'Unrecoverable error, File may be corrupt';
bNotLoaded : ErrorMsg := 'Record Manager not loaded';
bKeyBufferShort : ErrorMsg := 'Key buffer too short';
bDataBufferShort : ErrorMsg := 'Data buffer too short';
bPosBlockShort : ErrorMsg := 'Position block is not 128 bytes in size';
bPageSizeErr : ErrorMsg := 'Page size error';
bCreateIOErr : ErrorMsg := 'File creation error';
bNumberKeys : ErrorMsg := 'Number of keys is invalid';
bInvalidKeyPos : ErrorMsg := 'Invalid key position';
bRecordLenErr : ErrorMsg := 'Invalid record length';
bKeyLenErr : ErrorMsg := 'Invalid key length';
bNotBtrieveFile : ErrorMsg := 'File is not a Btrieve file';
bTransactionErr : ErrorMsg := '/T option was not specified';
bTransactionActive : ErrorMsg := 'A transaction is already active';
bTransactionFileErr : ErrorMsg := 'Transaction control file I/O error';
bTransactionEndErr : ErrorMsg := 'No begin transaction issued';
bTransactionMaxFiles: ErrorMsg := 'Maximum number of transaction files (12) exceeded';
bOpNotAllowed : ErrorMsg := 'Operation not allowed';
bAcceleratedErr : ErrorMsg := 'Incomplete accelerated access, File may be corrupt';
bInvalidAddress : ErrorMsg := 'Invalid record address';
bNullKeypath : ErrorMsg := 'Null key path';
bBadKeyFlags : ErrorMsg := 'Inconsistent key flags';
bFileAccessDenied : ErrorMsg := 'Access to file denied';
bMaxOpenFiles : ErrorMsg := 'Maximum number of files open';
bInvalidAltSequence : ErrorMsg := 'Invalid alternate collating sequence definition';
bKeyTypeErr : ErrorMsg := 'Key type error';
bOwnerIsSet : ErrorMsg := 'Owner is already set';
bInvalidOwner : ErrorMsg := 'Invalid owner';
bCacheWriteErr : ErrorMsg := 'Error writing cache buffer';
bInvalidVersion : ErrorMsg := 'Invalid Btrieve version';
bVariablePageErr : ErrorMsg := 'Variable page error';
bAutoIncrementErr : ErrorMsg := 'Autoincrement key error';
bBadIndex : ErrorMsg := 'A supplemental index is damaged';
bExpandedMemoryErr : ErrorMsg := 'Expanded memory error';
bCompressBuffShort : ErrorMsg := 'Compression buffer too short';
bFileExists : ErrorMsg := 'File already exists';
bTTSabort : ErrorMsg := 'Automatic transaction abort';
bDeadlock : ErrorMsg := 'Deadlock detected';
bConflict : ErrorMsg := 'Record has been changed';
bLockErr : ErrorMsg := 'File lock error';
bLostPosition : ErrorMsg := 'File positioning lost';
bOutOfTransaction : ErrorMsg := 'Read outside of a transaction';
bRecordInUse : ErrorMsg := 'Record in use';
bFileInUse : ErrorMsg := 'File in use';
bFileTblFull : ErrorMsg := 'File table is full';
bHandleTblFull : ErrorMsg := 'No file handles available';
bBadModeErr : ErrorMsg := 'Incompatible file open mode';
bDeviceTableFull : ErrorMsg := 'Redirected device table full';
bServerErr : ErrorMsg := 'Server error';
bTranTableFull : ErrorMsg := 'Transaction table full';
bBadLockType : ErrorMsg := 'Lock types are incompatible';
bPermissionErr : ErrorMsg := 'Permission error';
bSessionInvalid : ErrorMsg := 'Session no longer valid';
bCommunicationErr : ErrorMsg := 'Communications environment error';
bDataMessageShort : ErrorMsg := 'Data message to small';
bInternalTTSerr : ErrorMsg := 'Internal TTS error';
bOutOfMemory : ErrorMsg := 'Out of Memory';
else
ErrorMsg := 'Unknown error';
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : OpMsg |}
{| Class : ErrorHandler |}
{| Purpose : Return the message for a btrieve error code |}
{| Parameters : ErrorCode - a btrieve status code |}
{| Returns : A message string |}
{+--------------------------------------------------------------------------+}
Function ErrorHandler.OpMsg(OpCode : Integer): String;
begin
Case OpCode of
bOpen : OpMsg := 'Open file';
bClose : OpMsg := 'Close file';
bInsert : OpMsg := 'Insert new record';
bUpdate : OpMsg := 'Update existing record';
bDelete : OpMsg := 'Delete record';
bGetEqual : OpMsg := 'Read record equal to key';
bGetGreat : OpMsg := 'Read record greater than key';
bGetGreatEqual : OpMsg := 'Read record greater than or equal to key';
bGetLess : OpMsg := 'Read record less than key';
bGetLessEqual : OpMsg := 'Read record less than or equal to key';
bGetNext : OpMsg := 'Read next record';
bGetPrev : OpMsg := 'Read previous record';
bGetFirst : OpMsg := 'Read first record';
bGetLast : OpMsg := 'Read last record';
bCreate : OpMsg := 'Create file';
bStat : OpMsg := 'Get file statistics';
bBeginTransaction : OpMsg := 'Begin transaction';
bEndTransaction : OpMsg := 'End transaction';
bAbortTransaction : OpMsg := 'Abort transaction';
bGetPosition : OpMsg := 'Get record position';
bGetDirect : OpMsg := 'Read record by position';
bStepNext : OpMsg := 'Step to next record';
bStop : OpMsg := 'Unload record manager';
bVersion : OpMsg := 'Get version number';
bUnlock : OpMsg := 'Unlock';
bReset : OpMsg := 'Reset record manager';
bSetOwner : OpMsg := 'Set file owner';
bClearOwner : OpMsg := 'Clear file owner';
bCreateIndex : OpMsg := 'Creating supplemental index';
bDropIndex : OpMsg := 'Dropping supplemental index';
bStepFirst : OpMsg := 'Step to first record';
bStepLast : OpMsg := 'Step to last record';
bStepPrev : OpMsg := 'Step to previous record';
else
OpMsg := 'Unknown operation';
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : SetMaxRetry |}
{| Class : ErrorHandler |}
{| Purpose : Set the maximum number of retries for lock errors |}
{| Parameters : Retry - max. retries |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure ErrorHandler.SetMaxRetry(Retry : Word);
begin
MaxRetry := Retry;
end;
{+--------------------------------------------------------------------------+}
{| Name : GetMaxRetry |}
{| Class : ErrorHandler |}
{| Purpose : Get max. number of retries |}
{| Parameters : none |}
{| Returns : Maximum number of retries |}
{+--------------------------------------------------------------------------+}
Function ErrorHandler.GetMaxRetry: Word;
begin
GetMaxRetry := MaxRetry;
end;
{+--------------------------------------------------------------------------+}
{| Name : ClearRetry |}
{| Class : ErrorHandler |}
{| Purpose : Clear the current number of retries |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure ErrorHandler.ClearRetry;
begin
{ clear the current retry count }
RetryCount := 0;
end;
{+--------------------------------------------------------------------------+}
{| Name : SetDelay |}
{| Class : ErrorHandler |}
{| Purpose : Set the delay between lock retries |}
{| Parameters : Seconds - how long to wait |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure ErrorHandler.SetDelay(Seconds : Word);
begin
{ turn seconds into milliseconds }
RetryDelay := Seconds * 1000;
end;
{+--------------------------------------------------------------------------+}
{| Name : GetDelay |}
{| Class : ErrorHandler |}
{| Purpose : Get the seconds of delay between lock retries |}
{| Parameters : none |}
{| Returns : Seconds delay |}
{+--------------------------------------------------------------------------+}
Function ErrorHandler.GetDelay: Word;
begin
{ turn milliseconds into seconds }
GetDelay := RetryDelay Div 1000;
end;
{+--------------------------------------------------------------------------+}
{| Name : AddError |}
{| Class : ErrorHandler |}
{| Purpose : Add an error to the trapped error set |}
{| Parameters : ErrorCode - btrieve status code to add |}
{| Returns : none |}
{| Notes : All errors except bEOF are trapped by default |}
{+--------------------------------------------------------------------------+}
Procedure ErrorHandler.AddErrors(ErrorCodes : ErrorSet);
begin
TrappedErrors := TrappedErrors + ErrorCodes;
end;
{+--------------------------------------------------------------------------+}
{| Name : RemoveError |}
{| Class : ErrorHandler |}
{| Purpose : Remove a error form the trapped errors |}
{| Parameters : ErrorCode - btrieve status code to remove |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : bOkay will not be removed. |}
{| All errors except bEOF are trapped by default |}
{+--------------------------------------------------------------------------+}
Procedure ErrorHandler.RemoveErrors(ErrorCodes : ErrorSet);
begin
TrappedErrors := TrappedErrors - ErrorCodes;
end;
{+--------------------------------------------------------------------------+}
{| Name : SetErrors |}
{| Class : ErrorHandler |}
{| Purpose : Make the set of all trapped errors. |}
{| Parameters : ErrorCodes - A set of btrieve status codes to become the new|}
{| trapped error set. |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure ErrorHandler.SetErrors(ErrorCodes : ErrorSet);
begin
TrappedErrors := ErrorCodes;
end;
{+--------------------------------------------------------------------------+}
{| Name : GetErrors |}
{| Class : ErrorHandler |}
{| Purpose : Return the set of all trapped errors. |}
{| Parameters : ErrorCodes - The set of btrieve status codes currently |}
{| trapped. |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Procedure ErrorHandler.GetErrors(var ErrorCodes : ErrorSet);
begin
ErrorCodes := TrappedErrors;
end;
{+--------------------------------------------------------------------------+}
{| Name : ErrorDispatcher |}
{| Class : ErrorHandler |}
{| Purpose : This routine calls the error display object and if the error|}
{| display object says abort halts the program. |}
{| Parameters : ErrorCode - btrieve error |}
{| OpCode - btrieve operation that generate error |}
{| FileName - file the error occured with |}
{| Returns : If error is not fatal, a flag of type ErrorAction indicating|}
{| continue or start over. |}
{| Notes : Assumes there is an exit routine that will Reset btrieve if |}
{| desired. |}
{+--------------------------------------------------------------------------+}
Function ErrorHandler.ErrorDispacther(ErrorCode : Integer;
OpCode : Byte;
FileName : PathStr
): ErrorAction;
var
Action : ErrorAction;
begin
{ call error object to display the error messages }
{ and see if user wants to stop }
if (ErrDisplay <> nil) then
begin
Action := ErrDisplay^.Display(ErrorCode,
ErrorMsg(ErrorCode),
OpCode,
OpMsg(OpCode),
FileName);
{ the error is fatal, so abort through the defined exit procedure }
if (Action = erAbort) then
Halt(ErrorCode);
end
else
begin
Action := erDone;
end;
{ clear retries so we are ready for more looping }
ClearRetry;
ErrorDispacther := Action;
end;
{+--------------------------------------------------------------------------+}
{| Name : Error |}
{| Class : ErrorHandler |}
{| Purpose : Traps all non-programmer errors |}
{| Parameters : Status - the last btrieve status code |}
{| OpCode - btrieve operation that generate error |}
{| FileName - file the error occured with |}
{| Returns : TRUE as long as there is still an error. |}
{| Notes : This routine is called by all routines that execute a |}
{| btrieve operation. Any errors that are removed by a call to |}
{| RemoveError will return to the user program,all other errors|}
{| will be trapped. Lock errors (bRecordInUse, bFileInUse) |}
{| enter the retry loop. |}
{+--------------------------------------------------------------------------+}
Function ErrorHandler.Error(Status : Integer;
OpCode : Byte;
FileName : PathStr
): Boolean;
begin
{ handle all trapped errors }
if (Status in TrappedErrors) then
begin
{ these are lock errors }
if (Status = bRecordInUse) or (Status = bFileInUse) then
begin
{ if there are retries left }
if (RetryCount < MaxRetry) then
begin
Inc(RetryCount);
Delay(RetryDelay);
Error := True;
end
{ else go see what the user wants to do }
else
{ error dispatcher returns either a continue or start over }
Error := (ErrorDispacther(Status, OpCode, FileName) = erRetry);
end
{ any other error go see what the user wants to do }
else
{ error dispatcher returns either a continue or start over }
Error := (ErrorDispacther(Status, OpCode, FileName) = erRetry);
end {if}
{ else this is a programmer handled error }
else
begin
{ return with "No more error" status }
Error := False;
{ clear the retry counter so we are ready for more looping }
ClearRetry;
end; {else}
end;
{****************************************************************************
ERROR DISPLAY OBJECT
Note: These are abstract routines and provide no functionality they are
shells only. For each instance you must override these routines.
****************************************************************************=}
{+--------------------------------------------------------------------------+}
{| Name : Init |}
{| Class : ErrorDisplay |}
{| Purpose : Initialize the error display object. |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Constructor ErrorDisplay.Init;
begin
end;
{+--------------------------------------------------------------------------+}
{| Name : Display |}
{| Class : ErrorDisplay |}
{| Purpose : Display an error passed from the error handler |}
{| Parameters : ErrorNumber - the btrieve code that caused the call |}
{| OpCode - btrieve operation that generate error |}
{| ErrorMsg - error description |}
{| FileName - file the error occured with |}
{| Returns : Returns a flag of type ErrorAction indicating whether the |}
{| program should Abort, Continue, or Start Over. |}
{| Notes : In practice this routine must check the error and decide |}
{| what to do. This is where errors will be displayed and any |}
{| user response recieved. However the error is handled, this |}
{| routine must return some action (erAbort, erDone, erRetry) |}
{| to tell the error handler what to do next. |}
{+--------------------------------------------------------------------------+}
Function ErrorDisplay.Display(Error : Integer;
ErrorMsg : String;
OpCode : Byte;
OpCodeMsg : String;
FileName : PathStr
): ErrorAction;
begin
{ this procedure is virtual and must always be overridden }
{ a call here is illegal, so generate a runtime error }
RunError(211);
end;
{+--------------------------------------------------------------------------+}
{| Name : Done |}
{| Class : ErrorDisplay |}
{| Purpose : Destroy the object |}
{| Parameters : none |}
{| Returns : none |}
{+--------------------------------------------------------------------------+}
Destructor ErrorDisplay.Done;
begin
end;
{****************************************************************************
PROGRESS DISPLAY OBJECT
Note: These are abstract routines and provide no functionality they are
shells only. For each instance you must override these routines.
****************************************************************************=}
{+--------------------------------------------------------------------------+}
{| Name : Init |}
{| Class : TProgress |}
{| Purpose : Initialize the progress in display object. |}
{| Parameters : None |}
{| Returns : None |}
{+--------------------------------------------------------------------------+}
Constructor TProgress.Init;
begin
end;
{+--------------------------------------------------------------------------+}
{| Name : Display |}
{| Class : TProgress |}
{| Purpose : Display an the progress in during recover, save or load. |}
{| Parameters : Count - current record count |}
{| Returns : None |}
{| Notes : In practice this routine would display some sort of progress|}
{| update to calm the users fears that her amchine has locked. |}
{+--------------------------------------------------------------------------+}
Procedure TProgress.Display(Count : LongInt);
begin
end;
{+--------------------------------------------------------------------------+}
{| Name : CheckForBtrieve |}
{| Purpose : See if Btrieve is loaded and abort if it is not. |}
{| Parameters : none |}
{| Returns : none |}
{| Notes : Prints a message to the screen and halts with exit code 999 |}
{| if Btrieve is not found. |}
{+--------------------------------------------------------------------------+}
Procedure CheckForBtrieve;
var
I : Integer;
W : Word;
Regs : Registers;
St : String[80];
Len : Byte Absolute St;
Temp : Array[0..80] of Char;
begin
{ try a reset to see if Btrieve is loaded }
if (Btrv(bReset, I, I, W, I, 0) <> bOkay) then
begin
{ display a message and halt }
St := 'Btrieve Record Manager is not loaded, program aborted!';
Move(St[1], Temp[0], Len);
Temp[Len] := #13;
Temp[Len+1] := #10;
Temp[Len+2] := '$';
Regs.DS := Seg(Temp);
Regs.DX := Ofs(Temp);
Regs.AH := $09;
{ call DOS int 21h function 09h to print the string because unlike
Turbo's Writeln this output will get redirected
}
MsDos(Regs);
{ halt with some non-zero error so a parent process can tell
there was a problem
}
Halt(999);
end;
end;
{+--------------------------------------------------------------------------+}
{| Name : HeapFunc |}
{| Purpose : Make sure New and GetMem return nil on errors. |}
{+--------------------------------------------------------------------------+}
Function HeapFunc(Size : Word): Integer; FAR;
begin
HeapFunc := 1;
end;
BEGIN
HeapError := @HeapFunc; { Add a heap function so errors return nil }
{$IFDEF BCHECK}
CheckForBtrieve;
{$ENDIF}
END.